Option Explicit

Global Const BASE_AN = 1920  '1920 car cette année correspond à une année bisextile où le 1er mars est un lundi
                             'Ceci ne se reproduit que tous les 28 ans.
Global Const CORREC = -1

Function DateToSerial(année As Integer, mois As Integer, jour As Integer) As Long
    Dim ja As Long, jm As Long, j As Long, d As Double
    ja = année
    jm = mois
    If ja < 100 Then ja = ja + 1900
    If jm < 3 Then
        jm = jm + 12
        ja = ja - 1
    End If
    jm = jm - 3
    d = CDbl(ja - BASE_AN) * 365.25
    j = Fix(d)
    d = CDbl(jm) * 30.6 + 0.5
    j = j + Fix(d)
    DateToSerial = j + jour + CORREC
End Function

Function SerialToString(serie As Long) As String
    Dim n As Long, j As Long, m As Long, a As Long
    n = serie
    a = (n \ 1461) * 4 + BASE_AN
    n = n Mod 1461
    If n = 1460 Then
        a = a + 3
        n = 365
    Else
        a = n \ 365 + a
        n = n Mod 365
    End If
    m = 0
    j = Fix(CDbl(m + 1) * 30.6 + 0.5)
    Do While n >= j
        m = m + 1
        j = Fix(CDbl(m + 1) * 30.6 + 0.5)
    Loop
    j = Fix(CDbl(m) * 30.6 + 0.5)
    j = n - j - CORREC
    m = m + 3
    If m > 12 Then
        m = m - 12
        a = a + 1
    End If
    SerialToString = Format(j, "00") & "/" & Format(m, "00") & "/" & a
End Function

Function SerialToDate(serie As Long) As Date
    Dim n As Long, j As Long, m As Long, a As Long
    n = serie
    a = (n \ 1461) * 4 + BASE_AN
    n = n Mod 1461
    If n = 1460 Then
        a = a + 3
        n = 365
    Else
        a = n \ 365 + a
        n = n Mod 365
    End If
    m = 0
    j = Fix(CDbl(m + 1) * 30.6 + 0.5)
    Do While n >= j
        m = m + 1
        j = Fix(CDbl(m + 1) * 30.6 + 0.5)
    Loop
    j = Fix(CDbl(m) * 30.6 + 0.5)
    j = n - j - CORREC
    m = m + 3
    If m > 12 Then
        m = m - 12
        a = a + 1
    End If
    SerialToDate = DateSerial(a, m, j)
End Function

Function JourDeSemaine(serie As Long) As String
    Dim r As Long
    r = serie Mod 7
    Select Case r
        Case 0: JourDeSemaine = "lundi"
        Case 1: JourDeSemaine = "mardi"
        Case 2: JourDeSemaine = "mercredi"
        Case 3: JourDeSemaine = "jeudi"
        Case 4: JourDeSemaine = "vendredi"
        Case 5: JourDeSemaine = "samedi"
        Case 6: JourDeSemaine = "dimanche"
    End Select
End Function

Sub DifferenceDeTemps(ByVal ddebut As Date, ByVal dFin As Date, ByRef Jours As Long, ByRef Heures As Integer, ByRef Minutes As Integer, ByRef Secondes As Integer)
'Jours, Heures, Minutes et Secondes sont des variables ByRef fournies par l'appelant pour y mettre le résultat
    Dim jd As Integer, moisd As Integer, ad As Integer, hd As Integer, md As Integer, sd As Integer, tmd As Double
    Dim jf As Integer, moisf As Integer, af As Integer, hf As Integer, mf As Integer, sf As Integer, tmf As Double
    
    jd = Day(ddebut)
    moisd = Month(ddebut)
    ad = Year(ddebut)
    hd = Hour(ddebut)
    md = Minute(ddebut)
    sd = Second(ddebut)
    
    jf = Day(dFin)
    moisf = Month(dFin)
    af = Year(dFin)
    hf = Hour(dFin)
    mf = Minute(dFin)
    sf = Second(dFin)
    
    tmd = CDbl(DateToSerial(ad, moisd, jd)) * 86400# + CDbl(hd) * 3600# + CDbl(md) * 60# + CDbl(sd)
    tmf = CDbl(DateToSerial(af, moisf, jf)) * 86400# + CDbl(hf) * 3600# + CDbl(mf) * 60# + CDbl(sf)
    tmf = tmf - tmd
    Jours = tmf \ 86400
    tmf = tmf - CDbl(Jours) * 86400#
    Heures = tmf \ 3600
    tmf = tmf - CDbl(Heures) * 3600#
    Minutes = tmf \ 60
    tmf = tmf - CDbl(Minutes) * 60#
    Secondes = CInt(tmf)
End Sub

Function FinDeMois(DateDebut As Date) As Date
    Dim serie As Long, serie2 As Long
    serie = DateToSerial(Year(DateDebut), Month(DateDebut), Day(DateDebut))
    serie2 = serie + 1
    Do While Month(SerialToDate(serie2)) = Month(SerialToDate(serie))
        serie = serie + 1
        serie2 = serie2 + 1
    Loop
    FinDeMois = SerialToDate(serie)
End Function